perm filename ALAID1.PAL[HAL,HE]1 blob
sn#205224 filedate 1976-03-10 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00017 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00003 00002 COMMENT
C00004 00003 Fields and data: ALDOPS, BRKTAB
C00008 00004 INTERP
C00011 00005 TYPVAL
C00015 00006 I/O routines: TYPR50, INCHR, INOCT, INR50
C00019 00007 BRACE
C00023 00008 take care of break case
C00029 00009 NEWBRK, FNDBRK
C00031 00010 TPPSOP
C00034 00011 TYPADR, TYPOFS, INADR, INOFS
C00037 00012 Data structures: Notes, note cells, message buffers
C00038 00013 GETNOTE, SNDNOTE, SERVER
C00042 00014 DOGTBUF, DOUSBUF, DORLBUF
C00045 00015 TREATMESSAGE
C00047 00016 Driver for test of communications
C00048 00017 ! new stuff: KTABLE, LOOKUP
C00050 ENDMK
C⊗;
;COMMENT ⊗
.TITLE Test of ALAID
.IF1
.INSRT HALHED.PAL[HAL,HE]
.INSRT K2DEF.PAL[11,SYS]
.ENDC
. = INTRP
.INSRT HALIO.PAL[HAL,HE]
.INSRT LARGEB.PAL[HAL,HE]
;⊗
;Fields and data: ALDOPS, BRKTAB
COMMENT ∩ Leave all this out for communications test.
COMMENT ⊗ ALAID information resides in the ALDOPS table parallel to
the INTOPS table. Each psuedo-op has these fields: ⊗
II == 0
XX ALDFLG ;Holds bits indicating status of tracing
ALDBRK == 1 ; Break bit. When set, break on this psop.
ALDTRC == 2 ; Tracing bit. When set, trace this psop.
XX ALDARG ;Encoding the types of arguments taken by this psop.
XX ALDPNM ;The RAD50 print name of the psop. Two words
II == II + 2
OPSLTH == II/2 ;Number of words in each ALDOPS entry
.MACRO MAKEOP CNAME, ANAME, TYPES
;Compiler name, Address name, Types of arguments
II == .
0 ;ALDFLG
III == 0
II2 == 1
.IRP ARG,<TYPES>
.IF NB ARG
III == II2*ARG + III
II2 == 8*II2
.ENDC
.ENDM
III ;ALDARG
.RAD50 /ANAME/ ;ALDPNM
. = II + OPSLTH + OPSLTH;Just in case the ANAME was funny
.ENDM
A == 1
LA == 2
O == 3
LO == 4
N == 5
R50 == 6
; The interpreter operation debug table
ALDOPS: MAKEOP XINVALID,INVALD ;Illegal instruction
.INSRT INTOPS.PAL[HAL,HE]
COMMENT ⊗ There is a fixed number of available bracepoints. (Break
or trace points). When a bracepoint is in place, the old contents of
the instruction are stored in the breakpoint table. Bracepoints are
always kept in place. ⊗
II == 0
XX OLDPSOP ;Saved contents of psinstruction
XX OLDADR ;Where it comes from
XX BRCWHA ;Flags saying what to do.
ALDBRK == 1 ; Break bit. When set, this is a break point.
ALDTRC == 2 ; Tracing bit. When set, this is a tracepoint.
BRKLTH == II/2 ;Number of words in each entry
BRKNO == 10 ;Number of breakpoints available
BRKTAB: .BLKW BRKLTH*BRKNO
BRKDUM: .BLKW BRKLTH ;One dummy break table entry for bad entries
; INTERP
.MACRO BMPIPC ;
ADD #2,IPC(R4) ;Bump IPC
.ENDM ;
COMMENT ⊗ This is the interpreter loop which replaces the one in
INTERP.PAL. It does bounds checking for the instruction, then
catches single step, special traps or traces on this instruction
type, then breakpoints or tracepoints in the code. Finally it calls
the appropriate interpeter routine. ⊗
INTERP:
MOV R3,R0 ;Save the limit of the interpreter stack for error checking.
SUB #INSTSZ-2,R0
MOV R0,-(SP) ;
INT1: CMP R3,(SP) ;Interpreter stack overflow?
BGE INT3 ;No. Go to next instruction.
HALERR INTMS3 ;Yes. Complain.
INT3: MOV @IPC(R4),R0 ;R0 ← next instruction
BLE INVALID ;Instruction out of range
CMP R0,#INSEND ;Is instruction too large?
BLE INT2 ;No.
INVALID:HALERR INTMS1 ;Yes. complain.
INT2: BMPIPC ;Bump IPC
;catch single step
BIT #ALDSS,DEBMOD(R4) ;Single step?
BEQ INT4 ;No
INT5: JSR PC,BRACE ;R0 ← proper psop to execute
BR INTDO ;Now do the instruction
;catch break on instruction type
INT4: MOV #OPSLTH,R1 ;
MUL R0,R1 ;
ADD #ALDOPS,R1 ;
MOV R1,R2 ;R2 ← pointer into ALDOPS
BIT #ALDBRK,ALDFLG(R2) ;Break?
BNE INT5 ;Yes.
;catch brace instruction
CMP #XBRACE,R0 ;Is it a brace instruction?
BEQ INT5 ;Yes.
;catch trace on instruction type
BIT #ALDTRC,ALDFLG(R2) ;Trace?
BEQ INTDO ;No.
JSR PC,TRACE ;Yes.
INTDO: JSR PC,@INTOPS(R0) ;Call the appropriate routine
BR INTCPL(R0) ;R0 should have an completion code. Branch accordingly.
INTCPL: BR INT1 ;No error. Repeat.
HALERR INTMS2 ;Error. Complain.
BR INT1 ;And repeat.
INTMS1: ASCIE /INTERPRETER INSTRUCTION OUT OF RANGE/
INTMS2: ASCIE /INTERPRETED INSTRUCTION RETURNED FAILURE/
INTMS3: ASCIE /INTERPRETER STACK OVERFLOW/
; TYPVAL
TYPVAL:
COMMENT ⊗ R0 points to a value cell. Prints it according to its
type. Requires the floating package. ⊗
MOV R2,-(SP) ;Save R2
MOV R0,R2 ;R2 ← LOC[value cell]
MOV #CRLFX,R0 ;CRLF
JSR PC,TYPSTR ;
MOVB TAGID(R2),R1
CMPB #SCLID,R1 ;A scalar?
BEQ TYPVL1 ;
CMPB #VCTID,R1 ;A vector?
BEQ TYPVL4 ;
CMPB #TRNID,R1 ;A trans?
BEQ TYPVL5 ;
TYPVL1: MOV #SNAME,R0 ;
JSR PC,TYPSTR ;"SCALAR "
MOV #OUTBUF,R0 ;
TYPVL2: LDF (R2),AC0 ;
JSR PC,CVG ;
MOV #OUTBUF,R0 ;
JSR PC,TYPSTR ;
TYPVL3: MOV #CRLFX,R0 ;CRLF
JSR PC,TYPSTR ;
MOV (SP)+,R2 ;Restore R2
RTS PC ;Done
TYPVL4: MOV #VNAME,R0 ;
JSR PC,TYPSTR ;"VECTOR "
MOV #OUTBUF,R0 ;
LDF (R2)+,AC0 ;
JSR PC,CVG ;
LDF (R2)+,AC0 ;
JSR PC,CVG ;
BR TYPVL2 ;Bum code for last field.
TYPVL5: MOV #TNAME,R0 ;
JSR PC,TYPSTR ;"TRANS "
MOV R3,-(SP) ;Save R3
MOV #4,R3 ;R3 ← Number of rows
TYPVL6: MOV #CRLFX,R0 ;
JSR PC,TYPSTR ;
MOV #OUTBUF,R0 ;
LDF (R2),AC0 ;
JSR PC,CVG ;
LDF 20(R2),AC0 ;
JSR PC,CVG ;
LDF 40(R2),AC0 ;
JSR PC,CVG ;
LDF 60(R2),AC0 ;
JSR PC,CVG ;
MOV #OUTBUF,R0 ;
JSR PC,TYPSTR ;
ADD #4,R2 ;Next row
SOB R3,TYPVL6 ;
MOV (SP)+,R3 ;Restore R3
BR TYPVL3 ;Go to the exit stage
SNAME: ASCIE /SCALAR /
VNAME: ASCIE /VECTOR /
TNAME: ASCIE /TRANS /
;I/O routines: TYPR50, INCHR, INOCT, INR50
;Type contents of R0 as RAD50
TYPR50: MOV R0,R1 ;Arg in R1
CLR -(SP) ;Sentinel
JSR PC,TPR51 ;
TST (SP)+ ;
TPR54: RTS PC ;Done
TPR51: CLR R0
DIV #50,R0 ;Do one reduction
BEQ TPR52 ;Down to zero yet?
MOV R1,-(SP) ;Stack remainder.
MOV R0,R1
JSR PC,TPR51 ;And do it again.
MOV (SP)+,R1 ;R1 ← saved remainder.
TPR52: TST R1 ;Zero?
BEQ TPR54 ;Yes. Flush it.
CMP R1,#33 ;Letter, dollar?
BLT TPRLET ;Yes, letter
BEQ TPRDOL ;Yes, dollar
CMP R1,#35 ;Percent?
BEQ TPRPER ;Yes
ADD #22,R1 ;point or number
TPR53: MOV R1,R0 ;Ready to print
JMP TYPCHR ;TYPCHR will do the returning
TPRLET: ADD #100,R1
BR TPR53
TPRDOL: MOV #'$,R0
JMP TYPCHR
TPRPER: MOV #'%,R0
JMP TYPCHR
; Waits for a character to be typed, returns it in R0. Does not echo.
INCHR: TST OUTSW ;VT05 or console?
BEQ INCHR2 ;console
TSTB KBIS ;VT05 input ready?
BNE INCHR1 ;Yes.
INCHR3: SLEEP #1 ;No. Wait a while
BR INCHR ;And try again
INCHR1: MOVB KBIR,R0 ;Get a character
BIC #177600,R0 ;Make off to make it 7 bits
RTS PC ;Done
INCHR2: MOV IREG,R0 ;Get a character
BEQ INCHR3 ;Nothing there
CLR IREG ;Clear it for next character
RTS PC ;Done.
INR50:
COMMENT ⊗ Reads an alphameric string, returns the RAD50
representation in R0 and R1. Any characters after the 6th are lost.
Input terminated by any illegal RAD50 character. Backspace works. ⊗
INOCT:
COMMENT ⊗ Reads an octal number, returns it in R0. Any non-digit
terminates the number. Backspace will work properly. Echoes. ⊗
MOV R2,-(SP) ;Save R2
CLR R2 ;R2 is the eventual result
INCT3: JSR PC,INCHR ;R0 ← Character
CMP #177,R0 ;Backspace?
BNE INCT4 ;No
ASH #-3,R2 ;Get rid of last digit
MOV #DBS,R0 ;Peform deleting backspace. Defined in HALIO
JSR PC,TYPSTR ;
BR INCT3 ;Go back.
INCT4: CMP #'0,R0 ;Too small?
BGT INCT1 ;yes
CMP #'7,R0 ;Too large?
BGE INCT2 ;no
INCT1: MOV #40,R0 ;type a trailing " "
JSR PC,TYPCHR ;
MOV R2,R0 ;R0 ← result
MOV (SP)+,R2 ;Restore R2
RTS PC ;Done
INCT2: MOV R0,-(SP) ;Save the character
JSR PC,TYPCHR ;Echo it
ASH #3,R2 ;Compute new result
BIC #60,(SP) ;
ADD (SP)+,R2 ;
BR INCT3 ;And repeat
; BRACE
BRACE:
COMMENT ⊗
This routine can be called from anywhere. It expects that IPC(R4)
has been bumped once since the last instruction was fetched, that is,
the instruction is at IPC(R4)-2. The currently implemented
operations are:
DDT go to DDT, where <alt>P will return to here.
PROCEED exits this routine to whoever called it.
BREAK <adr> puts a breakpoint at <adr>
TRACE <adr> puts a tracepoint at <adr>
UNBRACE <adr> removes all bracepoints from <adr>
EXAMINE <lev-of>examines a variable
SINGLE STEP puts a trap on the next instruction, proceeds.
RESET remove all breakpoints.
When this routine exits, it has put the psop that it found in R0. If
the psop was <BREAK>, then the correct equivalent is either <NOOP>
for bad entry or the old psop for bracepoints. ⊗
;look up the instruction in the brace table.
MOV R2,-(SP) ;Save R2
MOV IPC(R4),R0 ;
SUB #2,R0 ;R0 ← address of broken instruction
JSR PC,FNDBRK ;R1 ← LOC[entry in break table], 0 for none found. R0←R0
MOV R1,R2 ;R2 ← LOC[entry in break table]
BNE BRK1 ;if any
MOV #BRKDUM,R2 ;nope. use the dummy break instruction.
MOV (R0),OLDPSOP(R2) ;initialize it.
MOV R0,OLDADR(R2);
MOV #ALDBRK,BRCWHA(R2) ;
BR BRK2 ;We know it is a break
;see if it is a break or a trace
BRK1: BIT #ALDSS,DEBMOD(R4) ;Single step?
BEQ BRK3 ;No
BIC #ALDSS,DEBMOD(R4) ;Turn it off.
MOV #BRKM00,R0 ;":SS:<cr>"
JSR PC,TYPSTR ;
BR BRK5 ;And otherwise just like a break.
BRK3: BIT #ALDBRK,BRCWHA(R2) ;Is the break bit on?
BNE BRK2 ;Yes
BIT #ALDTRC,BRCWHA(R2) ;The trace bit, then?
BEQ BRK4 ;No.
;take care of trace case
TRACE: MOV #TRCMS,R0 ;Yes. "<cr>:TRC:"
JSR PC,TYPSTR ;
MOV IPC(R4),R0 ;
SUB #2,R0 ;R0 ← LOC[psop]
JSR PC,TYPADR ;Tell where we are.
MOV OLDPSOP(R2),R0;Tell what psop
MOV OLDADR(R2),R1;
ADD #2,R1 ;R1 ← LOC[argument(s)]
JSR PC,TPPSOP ;
JMP BRKPC1 ;Go to the return place.
BRK4: MOV (SP)+,R2 ;Restore R2
RTS PC ;And exit.
;take care of break case
BRK2: MOV #BRKMS1,R0 ;":BRK:<cr>"
JSR PC,TYPSTR ;
BRK5: MOV IPC(R4),R0 ;
SUB #2,R0 ;R0 ← address of broken instruction
JSR PC,TYPADR ;Tell where we are.
MOV OLDPSOP(R2),R0;Tell what psop
MOV OLDADR(R2),R1;
ADD #2,R1 ;R1 ← LOC[argument(s)]
JSR PC,TPPSOP ;
BRKALD: MOV #BRKMS0,R0 ;Prompt
JSR PC,TYPSTR ;
JSR PC,INCHR ;See what the user wants to do.
CMP #15,R0 ;Carriage return?
BNE BRKPRC ;No.
MOV #CRLFX,R0 ;
JSR PC,TYPSTR ;
BR BRKALD ;
BRKPRC: CMP #'P,R0 ;Proceed?
BNE BRKDDT ;
MOV #BRKMS2,R0 ;
JSR PC,TYPSTR ;
BRKPC1: MOV OLDPSOP(R2),R0 ;Load up the psop
MOV (SP)+,R2 ;Restore R2
RTS PC ;and return
BRKDDT: CMP #'D,R0 ;DDT?
BNE BRKBRK ;
MOV #BRKMS3,R0 ;
JSR PC,TYPSTR ;
BPT ;
BR BRKALD ;
BRKBRK: CMP #'B,R0 ;Break?
BNE BRKUNB ;
MOV #BRKMS4,R0 ;
JSR PC,TYPSTR ;
JSR PC,INADR ;R0 ← address to put a break point.
BEQ BRKHUH ;If reasonable
MOV R0,-(SP) ;Save it
JSR PC,NEWBRK ;R0 ← nice place in the break table
BEQ BRKHUH ;If any
MOV @0(SP),OLDPSOP(R0)
MOV (SP),OLDADR(R0)
MOV #ALDBRK,BRCWHA(R0)
MOV #XBRACE,@(SP)+
BR BRKALD ;
BRKUNB: CMP #'U,R0 ;Unbreak?
BNE BRKREF ;
MOV #BRKMS5,R0 ;
JSR PC,TYPSTR ;
JSR PC,INADR ;R0 ← address to remove break point from.
BEQ BRKHUH ;If reasonable
JSR PC,FNDBRK ;R1 ← LOC[entry in break table], R0 unchanged
BEQ BRKHUH ;
MOV OLDPSOP(R1),@OLDADR(R1) ;Replace old instruction
;note that we do NOT clear the OLDPSOP field; we may need it to proceed.
CLR OLDADR(R1) ;
BR BRKALD ;
BRKREF: CMP #'R,R0 ;Refresh?
BNE BRKVAR ;
MOV #BRKMS8,R0 ;
JSR PC,TYPSTR ;
MOV #BRKNO,R1 ;R1 ← Count of breakpoints
MOV #BRKTAB,R0 ;R0 ← Pointer into break table
BRKR1: TST OLDADR(R0) ;A real break, or empty?
BEQ BRKR2 ;Empty
MOV OLDPSOP(R0),@OLDADR(R0) ;Replace old instruction
;note that we do NOT clear the OLDPSOP field; we may need it to proceed.
CLR OLDADR(R0) ;
BRKR2: SOB R1,BRKR1 ;Repeat as necessary
BR BRKALD ;
BRKVAR: CMP #'E,R0 ;Examine variable?
BNE BRKSS ;
MOV #BRKMS6,R0 ;
JSR PC,TYPSTR ;
JSR PC,INOFS ;R0 ← level-offset of variable
JSR PC,GETARG ;R0 ← LOC[LOC[graph node]
MOV (R0),R0 ;R0 ← LOC[Graph node]
MOV GNVAL(R0),R0;R0 ← LOC[value cell]
JSR PC,TYPVAL ;Print it.
BR BRKALD ;
BRKSS: CMP #'S,R0 ;Single step?
BNE BRKTRC ;
MOV #BRKMS7,R0 ;
JSR PC,TYPSTR ;
BIS #ALDSS,DEBMOD(R4) ;Set for single step
BR BRKPC1 ;and just proceed
BRKTRC: CMP #'T,R0 ;Trace?
BNE BRKHUH ;
MOV #BRKMS9,R0 ;
JSR PC,TYPSTR ;
JSR PC,INADR ;R0 ← address to put a trace point.
BEQ BRKHUH ;If reasonable
MOV R0,-(SP) ;Save it
JSR PC,NEWBRK ;R0 ← nice place in the break table
BEQ BRKHUH ;If any
MOV @0(SP),OLDPSOP(R0)
MOV (SP),OLDADR(R0)
MOV #ALDTRC,BRCWHA(R0)
MOV #XBRACE,@(SP)+
JMP BRKALD ;
BRKHUH: MOV #'π,R0 ;
JSR PC,TYPCHR ;
JMP BRKALD ;
TRCMS: ASCIE </
:TRC: />
BRKM00: ASCIE </
:SS: />
BRKMS0: ASCIE </NU? />
BRKMS1: ASCIE </
:BRK: />
BRKMS2: ASCIE /PROCEED /
BRKMS3: ASCIE /DDT /
BRKMS4: ASCIE /BREAK /
BRKMS5: ASCIE /UNBRACE /
BRKMS6: ASCIE /EXAMINE VARIABLE /
BRKMS7: ASCIE /SINGLE STEP /
BRKMS8: ASCIE /REFRESH /
BRKMS9: ASCIE /TRACE /
; NEWBRK, FNDBRK
FNDBRK:
COMMENT ⊗ Sets R1 to the entry in the break table which corresponds
to the pseudo-code address in R0. Does not change R0. If none is
found, returns 0 in R1. ⊗
MOV R2,-(SP) ;Save R2
MOV #BRKNO,R2 ;R2 ← count of possible breakpoints
MOV #BRKTAB,R1 ;R1 ← Pointer into break table
FNDBR1: CMP R0,OLDADR(R1)
BEQ FNDBR2 ;found
ADD #2*BRKLTH,R1;not yet found
SOB R2,FNDBR1 ;
CLR R1 ;will never find
FNDBR2: MOV (SP)+,R2 ;Restore R2
TST R1 ;So the caller won't have to.
RTS PC ;Done
NEWBRK:
COMMENT ⊗ Finds an empty location in the break table. If there is
none, returns a 0. Result is in R0. ⊗
MOV #BRKTAB,R0 ;First try
FNDB2: TST OLDADR(R0) ;Anything there?
BNE FNDB1 ;Yes.
TST R0 ;So caller won't have to.
RTS PC ;No. All is well
FNDB1: ADD #2*BRKLTH,R0;Try next one.
CMP R0,#BRKDUM ;if any
BLT FNDB2 ;
CLR R0 ;none left
RTS PC ;Done.
; TPPSOP
TPPSOP:
COMMENT ⊗ R0 holds the pseudo-instruction code, R1 points to
the argument (s). Print out the whole thing, using the information
in the ALDOPS for argument types. ⊗
MOV R2,-(SP) ;Save R2
MOV R3,-(SP) ;Save R3
MOV R4,-(SP) ;Save R4
MOV R1,R4 ;R4 ← LOC[argument(s)]
MOV #OPSLTH,R3 ;
MUL R0,R3 ;
ADD #ALDOPS,R3 ;R3 ← ponter into ALDOPS
MOV ALDPNM(R3),R0 ;Print name of psop
JSR PC,TYPR50 ;
MOV ALDPNM+2(R3),R0;
JSR PC,TYPR50 ;
MOV #40,R0 ;" "
JSR PC,TYPCHR ;
MOV ALDARG(R3),R2 ;R2 ← type of arguments
TPPS3: MOV R2,R3 ;
BNE TPPS1 ;Are there more?
MOV (SP)+,R4 ;No. Restore R4
MOV (SP)+,R3 ;Restore R3
MOV (SP)+,R2 ;Restore R2
RTS PC ;Done
TPPS1: CLR R2 ;Yes
DIV #8,R2 ;R2 ← the next type, R3 ← this type
ADD R3,R3 ;Chnage it to byte jump count
JMP @TPPS0(R3) ;go to the appropriate routine
BR TPPS3 ;Then do the next one
TPPS0: 0 ;
TPPSA ;
TPPSLA ;
TPPSO ;
TPPSLO ;
TPPSN ;
TPPSA: MOV (R4)+,R0 ;R0 ← the address
JSR PC,TYPADR ;Print it
BR TPPS3 ;
TPPSLA: MOV (R4)+,R0 ;R0 ← the next address
BEQ TPPS3 ;if any
JSR PC,TYPADR ;Print it
BR TPPSLA ;And do it again.
TPPSO: MOV (R4)+,R0 ;R0 ← level-offset
JSR PC,TYPOFS ;Print it
BR TPPS3 ;
TPPSLO: MOV (R4)+,R0 ;R0 ← level-offset
BEQ TPPS3 ;If any
JSR PC,TYPOFS ;Print it
BR TPPSLO ;And do it again
TPPSN: MOV (R4)+,R0 ;R0 ← the number
JSR PC,TYPOCT ;Print it
MOV #40,R0 ;" "
JSR PC,TYPCHR ;
BR TPPS3 ;
; TYPADR, TYPOFS, INADR, INOFS
TYPADR:
COMMENT ⊗ R0 holds an address in pseudo-code space. Print it out
symbolically. Temporarily, the printout is just octal. ⊗
JSR PC,TYPOCT ;
MOV #40,R0 ;
JSR PC,TYPCHR ;
RTS PC ;
INADR:
COMMENT ⊗ Reads from the tty a symbolic address. Returns the octal
equivalant in R0. Temporarily just reads in octal. If the address
is faulty, returns 0.
⊗
JSR PC,INOCT ;
BIT #1,R0 ;Odd?
BNE INADR2 ;Yes
CMP #PCODE,R0 ;No. In range?
BLE INADR1 ;Yes
INADR2: CLR R0 ;No.
INADR1: TST R0 ;So the caller won't have to.
RTS PC ;
TYPOFS:
COMMENT ⊗ R0 holds a level-offset pair. Print it out symbolically.
Temporarily, the printout is just "<level,offset>" ⊗
MOV R0,-(SP) ;Save the argument
MOV #'<,R0 ;
JSR PC,TYPCHR ;
CLR R0 ;
MOVB 1(SP),R0 ;The level
JSR PC,TYPOCT ;
MOV #',,R0 ;
JSR PC,TYPCHR ;
CLR R0 ;
MOVB (SP)+,R0 ;The offset
JSR PC,TYPOCT ;
MOV #'>,R0 ;
JSR PC,TYPCHR ;
MOV #40,R0 ;" "
JSR PC,TYPCHR ;
RTS PC ;
INOFS:
COMMENT ⊗ Reads from the tty a level-offset pair, which it returns in
R0. Temporarily just reads an octal offset, no level. ⊗
JSR PC,INOCT ;
BIC #177400,R0 ;Just wipe out any level
RTS PC ;
;∩ end of commented out portion for pure communications test
; Data structures: Notes, note cells, message buffers
; Notes from 10 to 11:
GETBUF == 1 ;
USEBUF == 2 ;
RELBUF == 3 ;
; Notes from 11 to 10:
BUFALC == 101 ;
TAKBUF == 102 ;
; Offsets in notes:
ARG1 == 2
ARG2 == 4
; Offsets in message buffers:
MESID == 0 ;
MESTYP == 2 ;
FROMTEN == 1 ;
FROMELF == 2 ;
REQUEST == 4 ;
ANSWER == 10 ;
MESLTH == 4 ;
MESBEG == 6 ;
NOTB10 = 100000 ; The notebox from 11 to the 10 (byte address)
NOTB11 = 100020 ; The notebox from 10 to the 11 (byte address)
NOTSIZ == 3 ; In WORDS!
; GETNOTE, SNDNOTE, SERVER
GETNOTE:
COMMENT ⊗ Returns the first note seen in a block pointed to by R0. ⊗
MOV R2,-(SP) ;Save R2
GTN2: TST NOTB11 ;Anything there?
BNE GTN1 ;Yes
SLEEP #100 ;No, so sleep a while
BR GTN2 ;And try again
GTN1: MOV #NOTSIZ,R0 ;
MOV R0,R2 ;R2 ← Count of how many words to transfer
JSR PC,GTFREE ;R0 ← place to store the note
MOV #NOTB11,R1 ;Transfer the note
GTN3: MOV (R1)+,(R0)+ ;
SOB R2,GTN3 ;Repeat
SUB #2*NOTSIZ,R0 ;Reset R0 to point to front of note.
CLR NOTB11 ;Clear the note, to say we got it.
MOV (SP)+,R2 ;Restore R2
RTS PC ;Done
SNDNOTE:
COMMENT ⊗ R0 point to a note to send. Send it and then release the
block. ⊗
MOV R2,-(SP) ;Sve R2
SDN2: TST NOTB10 ;Anything there?
BEQ SDN1 ;No.
SLEEP #100 ;Yes, so sleep a while
BR SDN2 ;And try again
SDN1: MOV #NOTSIZ-1,R1 ;R1 ← count of words to send
MOV #NOTB10+2,R2;R2 ← Where to put it.
TST (R0)+ ;Skip the first word; we will put it in last
SDN3: MOV (R0)+,(R2)+ ;
SOB R1,SDN3 ;Repeat
SUB #2*NOTSIZ,R0 ;Reset R0 ← LOC[note]
MOV (R0),NOTB10 ;Activate the note by sending the first word
JSR PC,RLFREE ;Release the block.
MOV (SP)+,R2 ;Restore R2
RTS PC ;Done
SERVER:
COMMENT ⊗ Listens for one note from the 10 and acts on it. ⊗
MOV R2,-(SP) ;Save R2
JSR PC,GETNOTE ;R0 ← LOC[note]
MOV (R0),R1 ;R1 ← type of note
MOV R0,R2 ;R2 ← LOC[note]
CMP R1,#GETBUF ;GETBUF
BNE SRV1 ;
JSR PC,DOGTBUF ;
BR SRV0 ;
SRV1:
CMP R1,#USEBUF ;USEBUF
BNE SRV2 ;
JSR PC,DOUSBUF ;
BR SRV0 ;
SRV2:
CMP R1,#RELBUF ;RELBUF
BNE SRV3 ;
JSR PC,DORLBUF ;
BR SRV0 ;
SRV3:
HALERR SRVMES ;Illegal code
SRV0: MOV R2,R0 ;Release the note.
JSR PC,RLFREE ;
MOV (SP)+,R2 ;Restore R2
RTS PC ;Done
SRVMES: ASCIE </CAN'T UNDERSTAND NOTE FROM THE 10/>
; DOGTBUF, DOUSBUF, DORLBUF
DOGTBUF:
COMMENT ⊗ Called by SERVER. The 10 wants us to allocate a buffer.
R0 = LOC[note]. The size in bytes is in ARG1(R0). We should respond
with BUFALC <size> <adr>. ⊗
MOV ARG1(R0),R0 ;R0 ← size argument
MOV R0,-(SP) ;Save size argument
JSR PC,GTFREE ;Get the buffer out of free storage
MOV R0,-(SP) ;Save buffer address
MOV #NOTSIZ,R0 ;
JSR PC,GTFREE ;R0 ← LOC[new note to send]
MOV #BUFALC,(R0) ;BUFALC
MOV (SP)+,ARG2(R0) ; <adr>
MOV (SP)+,ARG1(R0) ; <size>
JSR PC,SNDNOTE ;Send the note off. (He will destroy it)
RTS PC ;Done
DOUSBUF:
COMMENT ⊗ Called by SERVER. R0 = LOC[note]. The buffer that starts
at address ARG1(R0) is a message. Look at it, act on it, and then
recycle the message buffer. ⊗
MOV ARG1(R0),R0 ;R0 ← LOC[message]
JSR PC,TREATIT ;Treat it and release it
RTS PC ;Done
DORLBUF:
COMMENT ⊗ Called by SERVER. R0 = LOC[note]. The buffer that starts
at ARG1(R0) has been used by the 10, and we may deallocate it now. ⊗
MOV ARG1(R0),R0 ;R0 ← LOC[expended message]
JSR PC,RLFREE ;
RTS PC ;Done
; TREATMESSAGE
TREATMESSAGE:
COMMENT ⊗ R0 = LOC[buffer from the 10]. Print out its contents and
treat it. ⊗
MOV R2,-(SP) ;Save R2
MOV R0,R2 ;R2 ← LOC[buffer]
;print the message
ADD #MESBEG,R0 ;R0 ← LOC[start of message itself]
JSR PC,TYPSTR ;Print it
;see what kind of message it is
MOV R2,R0 ;
ADD #MESBEG,R0 ;R0 ← LOC[start of message itself]
JSR PC,LOOKUP ;This will perform the desired action.
MOV (SP)+,R2 ;Restore R2
RTS PC ;Eventually, the 10 will give us back the buffer,
;and we will discard it.
; Driver for test of communications
PUTLOC JOBDAT, MAINBL
PUTLOC JOBSA, START
MAINBL: PDBLK 400,S ;Makes a process descriptor for main process
START: JSR PC,IOINIT ;
JSR PC,FRINIT ;
CLR NOTB10 ;
CLR NOTB11 ;
JSR PC,SERVER ;We exist but to serve
BR .-4
.END
! new stuff: KTABLE, LOOKUP;
.MACRO KWORD KNAME, KADDR
II == .
ASCIE /ANAME/
. = II + 6 ;Truncate to 6 characters
KADDR ;The address of the service routine
KTABLE:
II == 0
KWORD GETVAL, DOGETVAL
KWORD ISVAL, DOISVAL
KTEND: .WORD 0
COMMENT ⊗ R0 ← LOC[string]. Find which keyword heads the string, and
call the appropriate routine for that keyword. ⊗
LOOKUP: ; Use a disgusting linear search
MOV R2,-(SP) ;Save R2
CLR R1 ;R1 ← Offset into KTABLE
LKP2: CMP (R0),KTABLE(R1) ;Match the first 2 letters?
BEQ LKP1 ;Yes
LKP3: ADD #10,R1 ;Try next entry
INC R1 ;
CMP R1,KTLTH ;Off the end?
BLT LKP2 ;No.
BR LKP4 ;Yes.
LKP1: CMP 2(R0),KTABLE+2(R1) ;Match the next 2 letters?
BNE LKP3 ;No
CMP 4(R0),KTABLE+4(R1) ;Match the last 2 letters?
BNE LKP3 ;No
ADD #6,R0 ;R0 ← end of key
LKP4: CMPB (R0)+,#40 ;Skip spaces
BEQ LKP5 ;
DEC R0 ;
JSR PC,@10(R1) ;Call the indicated routine
MOV (SP)+,R2 ;Restore R2
RST PC ;Done